perm filename PARSER.SAI[2,TES]6 blob
sn#041218 filedate 1973-05-07 generic text, type T, neo UTF8
00100 ENTRY MANUSCRIPT ;
00200 BEGIN "PARSER"
00300
00400 DEFINE TERNAL = "EXTERNAL" , PRELOAD = "COMMENT" ;
00500 REQUIRE "PUBDFS.SAI" SOURCE_FILE ;
00600 REQUIRE "PUBMAI.SAI" SOURCE_FILE ;
00700 BEGIN "INNER BLOCK"
00800 REQUIRE "PUBINR.SAI" SOURCE_FILE ;
00900 REQUIRE "PUBPRO.SAI" SOURCE_FILE ;
01000
01100 EXTERNAL RECURSIVE BOOLEAN PROCEDURE TEXTLINE ;
01200
01300 EXTERNAL RECURSIVE PROCEDURE DBREAK ;
01400
01500 EXTERNAL STRING SIMPLE PROCEDURE LABELREF(INTEGER USYMB, LEN) ;
01600
01700 FORWARD INTERNAL RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID) ;
01800
01900 FORWARD INTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
00100 INTERNAL STRING SIMPLE PROCEDURE RD(INTEGER BRKTBL) ;
00200 BEGIN
00300 COMMENT INPUTSTR = [ [chars] LF line-no TB ]... [chars]
00400 All break tables should break on LF.
00500 RD's value is as if LF line-no TB were null. ;
00600 INTEGER PTR, BYTEWD ; STRING SPTR, RESULT, PART ;
00700 RESULT ← NULL ;
00800 DO BEGIN "PARTIAL"
00900 PART ← SCAN(INPUTSTR, BRKTBL, BRC) ;
01000 IF BRC = LF THEN
01100 BEGIN "MACRO LINE NUMBER"
01200 MACLINE ← SCAN(INPUTSTR, TO_TB_FF_SKIP, DUMMY) ;
01300 IF PART[∞ FOR 1] = LF THEN comment he Appended the break character ;
01400 PART ← IF DEFINING THEN PART & MACLINE & TB ELSE PART[1 TO ∞-1]
01500 ELSE IF DEFINING THEN PART ← PART & LF & MACLINE & TB ;
01600 END "MACRO LINE NUMBER"
01700 ELSE IF BRC = 0 THEN comment, ran out of input ;
01800 IF INPUTCHAN < 0 THEN INPUTSTR ← SWICHBACK comment, done scanning macro body ;
01900 ELSE BEGIN "FROM FILE"
02000 DO BEGIN comment, may be page marks or eof or more lines ;
02100 IF TECOFILE THEN
02200 BEGIN COMMENT CHECK FOR FF AND SUPERFLUOUS LFs ;
02300 SRCLINE ← CVS(CVD(SRCLINE)+1) ;
02400 INPUT(INPUTCHAN, NO_CHARS) ;
02500 WHILE BRC = LF DO
02600 BEGIN
02700 INPUT(INPUTCHAN,ONE_CHAR) ;
02800 INPUT(INPUTCHAN,NO_CHARS) ;
02900 END ;
03000 END
03100 ELSE SRCLINE ← INPUT(INPUTCHAN, TO_TB_FF_SKIP) ;
03200 IF BRC = FF THEN
03300 BEGIN "PGMARK"
03400 PAGEMARKS ← PAGEMARKS + 1 ;
03500 IF TECOFILE THEN
03600 BEGIN
03700 INPUT(INPUTCHAN, ONE_CHAR) ;
03800 SRCLINE ← "0" ;
03900 END ;
04000 WHILE INPGS ∧ LAST=4 ∧ BRC=FF ∧ PAGEMARKS>RH(INPG[INPGX]) DO
04100 IF (INPGX←INPGX+1)>INPGS THEN BEGIN BRC←0 ; EOF←1 END
04200 ELSE IF PAGEMARKS<(K←LH(INPG[INPGX])) THEN
04300 DO BEGIN "SKIP PAGES"
04400 DO INPUT(INPUTCHAN,TO_LF_TB_VT_SKIP)
04500 UNTIL BRC≠TB;
04600 IF BRC = LF THEN
04700 DO BEGIN
04800 SRCLINE←INPUT(INPUTCHAN,TO_TB_FF_SKIP);
04900 IF BRC=FF THEN PAGEMARKS←PAGEMARKS+1 ;
05000 END UNTIL BRC≠FF ;
05100 END "SKIP PAGES"
05200 UNTIL BRC≠TB ∨ PAGEMARKS ≥ K ;
05300 IF ¬EOF THEN
05400 BEGIN COMMENT COMPUTE AND DISPLAY PAGE NUMBER ;
05500 SRCPAGE ← CVS(PAGEMARKS) ;
05600 IF NOT PUBSTD THEN OUTSTR((
05700 IF SWDBACK<0 THEN CRLF&SPS(LAST)
05800 ELSE IF SWDBACK>0 THEN SPS(LAST)
05900 ELSE SP
06000 )&SRCPAGE) ;
06100 SWDBACK ← 0 ;
06200 END ;
06300 END "PGMARK" ;
06400 END
06500 UNTIL BRC ≠ FF ;
06600 MACLINE ← NULL ;
06700 IF FULSTR(LSTOP) ∧ EQU(ERRLINE&"/"&SRCPAGE, LSTOP) THEN
06800 BEGIN
06900 DARN(NULL,VS(THISWD)&VS(THATWD)&VS(INPUTSTR)&CRLF&
07000 VS(OWL[1 TO OAKS])&CRLF&VI(POSN)&VI(BRC)&VI(BRKTBL)) ;
07100 S ← INCHWL ; LSTOP←("0000"&SCAN(S,DIGITA,DUMMY))[∞-4 FOR 5]&S ;
07200 END ;
07300 IF EOF THEN INPUTSTR ← SWICHBACK comment, done scanning a SOURCE_FILE or gen-file;
07400 ELSE BEGIN "FILE LINE"
07500 DO BEGIN "EXPAND TABS"
07600 INPUTSTR ← INPUTSTR & INPUT(INPUTCHAN,TO_LF_TB_VT_SKIP) ;
07700 IF BRC=TB THEN INPUTSTR←INPUTSTR&
07800 (IF PAGESCAN(LAST)≥0 THEN
07900 IF TABTAB=0 THEN
08000 SPS(8-LENGTH(INPUTSTR) MOD 8)
08050 ELSE TABTAB
08100 ELSE TB)
08200 ELSE IF BRC=VT THEN
08300 IF INPUTSTR[∞ FOR 1]="}" THEN INPUTSTR←INPUTSTR&VT
08400 ELSE
08500 BEGIN "GENVT" COMMENT MAYBE {PAGE!} IN GEN-FILE ;
08600 SPTR ← INPUT(INPUTCHAN, TO_VT_SKIP) ;
08700 IF (PTR ← CVD(SPTR)) ≥ 2↑14
08800 AND LDB(PLIGHTWD(BYTEWD←ITBL[PTR-2↑14]))=2
08900 THEN INPUTSTR ← INPUTSTR[1 TO ∞-6] &
09000 STBL[LDB(IXWD(BYTEWD))]
09100 ELSE INPUTSTR ← INPUTSTR & VT & SPTR & VT ;
09200 END "GENVT"
09300 END "EXPAND TABS"
09400 UNTIL BRC = LF ∨ BRC < 0 ∨ EOF ;
09500 IF BRC≤0 THEN
09600 BEGIN BRC ← LF ;
09700 IF ¬EOF THEN
09800 WARN("=","GARBAGED MANUSCRIPT "&ERRLINE&"/"&SRCPAGE)
09900 END ;
10000 IF DEFINING THEN PART ← PART & LF & SRCLINE & "/" & SRCPAGE & TB ;
10100 END "FILE LINE" ;
10200 END "FROM FILE" ;
10300 IF BRC = LF THEN
10400 IF DEFINING THEN BEGIN BRC←0 ; IF INPUTSTR=COMMAND_CHARACTER THEN
10500 BEGIN PART ← PART & TB ; LOPP(INPUTSTR) ; END END
10600 ELSE IF INPUTSTR = COMMAND_CHARACTER ∨ INPUTSTR = TB THEN
10700 BEGIN
10800 LOPP(INPUTSTR) ;
10900 BRC ← 0 ; comment, keep scanning ;
11000 END
11100 ELSE INPUTSTR ← (BRC ← "}") & VT & INPUTSTR ;
11200 IF BRC THEN RETURN(IF LENGTH(RESULT)=0 THEN PART
11300 ELSE IF LENGTH(PART)=0 THEN RESULT
11400 ELSE RESULT & PART)
11500 ELSE IF LENGTH(RESULT)=0 THEN RESULT ← PART
11600 ELSE RESULT ← RESULT & PART ;
11700 END "PARTIAL"
11800 UNTIL FALSE ;
11900 END "RD" ;
00100 INTERNAL SIMPLE PROCEDURE RDENTITY ;
00200 BEGIN Comment Sets THATWD, THATTYPE, LIT_ENTITY, LIT_TRAIL ;
00300 STRING SEGMENT, SOURCE ; BOOLEAN DUN, TEXTLN ; INTEGER CC, FAM ; LABEL RETRY ;
00400 TEXTLN ← FALSE ; RETRY: IF CHARTBL[INPUTSTR] LAND 2↑6 THEN RD(TO_VISIBLE) ;
00500 SOURCE ← INPUTSTR ;
00600 FAM ← LDB(FAMILY(SOURCE)) ;
00700 CASE FAM MIN QUOTEQ+1 OF
00800 BEGIN COMMENT BY FAMILY ;
00900 ie 0 ... Letter ;
01000 BEGIN "BUILD ID"
01100 CC ← LENGTH(SEGMENT ← SCAN(SOURCE, ALPHA, BRC)) ;
01200 THATWD ← CAPITALIZE(SEGMENT);
01300 THATTYPE ← 0 ;
01400 END "BUILD ID" ;
01500 ie 1 ... Digit ;
01600 BEGIN "BUILD INTEGER"
01700 CC ← LENGTH(THATWD ← "0" & SCAN(SOURCE, DIGITA, BRC)) - 1 ;
01800 THATTYPE ← -1 ;
01900 END "BUILD INTEGER" ;
02000 ie 2 ... EMPTYQ ; IMPOSSIBLE("RDENTITY") ;
02100 ie 3 ... Terminal ;
02200 BEGIN "MAYBE TEXT"
02300 IF LDB(SPECIES("THATWD ← LOP(SOURCE)")) = 0 THEN TEXTLN ← TRUE ;
02400 CC ← 1 ; THATTYPE ← -TERQ ;
02500 END "MAYBE TEXT" ;
02600 ie 4 ... Quote ;
02700 IF SOURCE = """" THEN
02800 BEGIN "STRING CONSTANT"
02900 DUN ← FALSE ; THATWD ← "7" ; LOPP(SOURCE) ; CC ← 1 ; ie skip " ;
03000 DO BEGIN "TO NEXT QUOTE"
03100 SEGMENT ← SCAN(SOURCE, TO_QUOTE_APPD, BRC) ;
03200 CC ← CC + LENGTH(SEGMENT) ;
03300 IF BRC ≠ """" THEN
03400 BEGIN "ERROR"
03500 THATWD ← THATWD & SEGMENT[1 TO ∞-1] ; DUN ← TRUE ;
03600 WARN("=","Omitted Right Quote From: "&THATWD) ;
03700 END "ERROR"
03800 ELSE IF SOURCE = """" THEN
03900 BEGIN "INTERNAL QUOTE"
04000 THATWD ← THATWD & SEGMENT ;
04100 LOPP(SOURCE) ; CC ← CC + 1 ; ie skip second " ;
04200 END "INTERNAL QUOTE"
04300 ELSE
04400 BEGIN "END STRING"
04500 THATWD ← THATWD & SEGMENT[1 TO ∞-1] ;
04600 DUN ← TRUE ;
04700 END "END STRING"
04800 END "TO NEXT QUOTE"
04900 UNTIL DUN ;
05000 THATTYPE ← -1 ;
05100 END "STRING CONSTANT"
00100 ELSE
00200 BEGIN "OCTAL CONSTANT"
00300 LOPP(SOURCE) ; THATTYPE ← -1 ;
00400 CC ← LENGTH(SEGMENT ← SCAN(SOURCE, DIGITA, BRC)) + 1 ;
00500 THATWD ← "8" & (DUMMY←CVO(SEGMENT)) ; COMMENT a one-character string ;
00600 IF DUMMY='0 ∨ '11≤DUMMY≤'15 ∨ DUMMY=ALTMODE ∨ DUMMY=RUBOUT THEN
00700 BEGIN
00800 WARN("=","Illegal octal constant (represents illegal character)") ;
00900 THATWD ← "7" ;
01000 END ;
01100 END "OCTAL CONSTANT" ;
01200 ie 5 ... Other ;
01300 BEGIN "SINGLE CHARACTER"
01400 THATTYPE ← -FAM ; CC ← 1 ; THATWD ← LOP(SOURCE) ;
01500 IF FAM = MISCQ THEN CASE LDB(SPECIES(THATWD)) OF
01600 BEGIN
01700 [4] ie ∞ ; BEGIN THATTYPE ← 0 ; THATWD ← "!INF" END ;
01800 [0] BEGIN "ILL CHAR"
01900 WARN("=","EXTRANEOUS `" & THATWD & "' in command line") ;
02000 LOPP(INPUTSTR) ; GO TO RETRY ;
02100 END "ILL CHAR" ;
02200 [MISCMAX]
02300 END ;
02400 END "SINGLE CHARACTER" ;
02500 END ; COMMENT BY FAMILY ;
02600 LIT_ENTITY ← INPUTSTR[1 TO CC] ;
02700 INPUTSTR ← SOURCE ;
02800 LIT_TRAIL ← IF TEXTLN THEN NULL ELSE IF CHARTBL[INPUTSTR] LAND 2↑6 THEN RD(TO_VISIBLE) ELSE NULL ;
02900 END "RDENTITY" ;
00100 INTEGER SIMPLE PROCEDURE ESTIMATE ;
00200 BEGIN
00300 INTEGER TOT, LEFT ;
00400 TOT ← LEFT ← IF AREAIXM ∧ 0≤STATUS≤2 THEN LINES ELSE LINECT(IXTEXT) ;
00500 IF STATUS=1 THEN LEFT ← LEFT - (LINE + COVERED + PINE) ;
00600 IF NOT NOPGPH THEN LEFT ← LEFT - ( 1+(ABOVEX MAX BRKABX)-(BELOWX MIN BRKBLX)+
00700 (IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1) ) ;
00800 RETURN(IF LEFT<0 THEN -(LEFT+TOT) ELSE LEFT) ;
00900 END "ESTIMATE" ;
01000
01100 INTEGER SIMPLE PROCEDURE EMPTYCOLS ;
01200 IF COL = 0 THEN RETURN(COLS)
01300 ELSE BEGIN
01400 INTEGER COUNT, COLUMN ; COUNT ← 0 ;
01500 FOR COLUMN ← (COL - 1) MOD COLS + 1 THRU COLS DO
01600 IF AA[COLUMN, 0] = 0 ∧ AA[COLUMN+COLS,0] = 0 THEN COUNT ← COUNT + 1 ;
01700 RETURN(COUNT-(IF ESTIMATE<0 THEN 1 ELSE 0)) ;
01800 END "EMPTYCOLS" ;
01900
02000 INTERNAL STRING SIMPLE PROCEDURE EVALV(STRING THISWD ; INTEGER IX, TYP) ;
02100 BEGIN comment, evaluates the "variable" in THISWD ;
02200 CASE TYP OF
02300 BEGIN COMMENT BY TYPE ;
02400 [0] BEGIN IF ON THEN WARN("=","Undefined Identifier " & THISWD) ; RETURN(VIRGIN) END ;
02500 [GLOBALTYPE] RETURN(STBL[IX]) ;
02600 [LOCALTYPE] RETURN(SSTK[IX]) ;
02700 [INTERNTYPE]
02800 BEGIN "INTERNAL"
02900 RETURN(CASE IX OF (
03000 ie 0 ... LINES ; CVS(ABS(ESTIMATE)),
03100 ie 1 ... COLUMNS; CVS(CASE STATUS+1 OF (
03200 ie -1 ... no place area ; 0,
03300 ie 0 ... unopened area ; COLS-(IF ESTIMATE<0 THEN 1 ELSE 0),
03400 ie 1 ... open area ; EMPTYCOLS,
03500 ie 2 ... closed area ; 0,
03600 ie 3 ... dis-declared ; 0) ),
03700 ie 2 ... ! ; !,
03800 ie 3 ... SPREAD ; CVS(SPREADM),
03900 ie 4 ... FILLING; IF ¬FILL THEN "0" ELSE IF ADJUST THEN "1" ELSE "-1",
04000 ie 5 ... _SKIP_ ; CVS(MANUS_SKIP_),
04100 ie 6 ... _SKIPL_; CVS(LH(MANUS_SKIP_)),
04200 ie 7 ... _SKIPR_; CVS(RH(MANUS_SKIP_)),
04300 ie 8 ... NULL ; NULL,
04400 ie 9 ... ∞ ; CVS(INF),
04500 ie 10... FOOTSEP; FOOTSEP,
04600 ie 11... TRUE ; "-1",
04700 ie 12... FALSE ; "0",
04800 ie 13... INDENT1; CVS(FIRSTIM),
04900 ie 14... INDENT2; CVS(RESTIM),
05000 ie 15... INDENT3; CVS(RIGHTIM),
05100 ie 16... LMARG ; CVS(LMARG),
05200 ie 17... RMARG ; CVS(RMARG),
05300 ie 18... CHAR ; IF NOPGPH THEN 0 ELSE CVS(POSN),
05400 ie 19... CHARS ; CVS(IF NOPGPH THEN RMARG-LMARG ELSE MAXIM-POSN),
05500 ie 20... LINE ; CVS(IF STATUS=1 THEN LINE ELSE 0),
05600 ie 21... COLUMN ; CVS(IF STATUS=1 THEN COL ELSE 0),
05700 ie 22... TOPLINE; CVS(LINE1(IF AREAIXM THEN AREAIXM ELSE IXTEXT)) ) ) ;
05800 END "INTERNAL" ;
05900 [MANTYPE] WARN("=",THISWD&" in an expression") ;
06000 [PORTYPE] RETURN(THISWD) ;
06100 [PUNITTYPE] RETURN(PATT_VAL("PATT_STRS(IX)")) ;
06200 [AREATYPE] RETURN(THISWD) ;
06300 [UNITTYPE] RETURN(CTR_VAL("PATT_STRS(IX)"))
06400 END COMMENT BY TYPE ; ;
06500 RETURN(NULL) ;
06600 END "EVALV" ;
06700
06800 INTERNAL STRING SIMPLE PROCEDURE VEVAL ; RETURN(EVALV(THISWD, IX, THISTYPE)) ;
00100 INTERNAL RECURSIVE STRING PROCEDURE PASS ; comment Value is always NULL ;
00200 BEGIN comment, Load up WD[0:1], TYPE[0:1], SYMB, and IX for the parser.
00300 Calls CHUNK recursively! PASS will expand macro calls,
00400 replace macro/response arguments with their actual values,
00500 skip over comments, and execute asides.;
00600 PRELOAD_WITH 0, [3]3, 2, [4]3, 0, 1, 0, 4, [5]0, 5, 0, 0, 6, [7]0, 7, 0 ;
00700 OWN INTEGER ARRAY SCANTYPE[-15:15] ; comment, computes small case index ;
00800 BOOLEAN FINAL ;
00900 DO BEGIN "LOAD WD 0"
01000 IF ¬THATISFULL THEN RDENTITY ;
01100 THISWD ← THATWD ;
01200 THISTYPE ← IF THATTYPE THEN THATTYPE comment, non-identifier ;
01300 ELSE IF SYMLOOK(THATWD) THEN LDB(TYPEN(SYMBOL))
01400 ELSE 0 ; comment, undeclared identifier ;
01500 IF THISTYPE ≠ -TERQ THEN RDENTITY ;
01600 IF THISISID THEN
01700 BEGIN "IDENTIFIER"
01800 SYMB ← SYMBOL ;
01900 IF ¬DCLR_ID ∧ THATISID ∧ SYMLOOK(THISWD & SP & THATWD) THEN
02000 BEGIN comment, two-word macro name ;
02100 THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← MACROTYPE ;
02200 IX ← LDB(IXN(SYMBOL)) ; RDENTITY ;
02300 END
02400 ELSE BEGIN SYMBOL←SYMB ; IF NULSTR(SYM[SYMB]) THEN ENTERSYM(THISWD,0) ; IX←LDB(IXN(SYMB)) ;END ;
02500 END "IDENTIFIER" ;
02600 FINAL ← FALSE ;
02700 DO CASE SCANTYPE[THISTYPE] OF
02800 BEGIN COMMENT DETECT ;
02900 ie 0 ... Nothing to do ; BEGIN END ;
03000 ie 1 ... $ ; IF NEXTSCH("(") THEN
03100 BEGIN EMPTYTHAT ; THISWD←"⊂" ;
03200 IX ← LDB(SPECIES(THISWD)) ; THISTYPE ← -TERQ ;
03300 END
03400 ELSE IX←LDB(SPECIES(THISWD)) ; COMMENT REPLACED OLD "ASIDE" (UNPUBL. FEATURE) 2/20/73 ;
03500 ie 2 ... < Family ; IF ITSCH(<) AND NEXTSCH(<) THEN
03600 BEGIN "<<COMMENT>>" SETBREAK(LOCAL_TABLE, ">}"&LF, NULL, "IS") ;
03700 DO RD(LOCAL_TABLE) UNTIL BRC=">" ∧ INPUTSTR=">" ∨ BRC="}" ∧ INPUTSTR=VT ;
03800 IF BRC=">" THEN RD(ONE_CHAR)
03900 ELSE BEGIN WARN("=","Unterminated <<comment>>") ; INPUTSTR←BRC&INPUTSTR END ;
04000 EMPTYTHIS ; EMPTYTHAT ;
04100 END "<<COMMENT>>"
04200 ELSE IX ← LDB(SPECIES(THISWD)) ; ie relational operator ;
04300 ie 3 ... Expression Operators ; IX ← LDB(SPECIES(THISWD)) ;
04400 ie 4 ... Terminal ;
04500 BEGIN
04600 IF ITSCH("]") ∧ INPUTSTR="$" THEN
04700 BEGIN LOPP(INPUTSTR) ; THISWD ← "}" END ;
04800 EMPTYTHAT ; IX ← LDB(SPECIES(THISWD)) ;
04900 END ; Comment NOTE!! }),]⊂;
05000 ie 5 ... internal variable ; IF ¬DCLR_ID ∧ IX ≥ 200 THEN
05100 BEGIN "OPERATOR"
05200 IX ← IX-200 ; comment e.g., NOT → ¬ ;
05300 THISTYPE ← -LDB(FAMILY(IX)) ;
05400 IX ← LDB(SPECIES(IX)) ;
05500 END "OPERATOR" ;
00100 ie 6 ... reserved word ; IF IX=IXCOMMENT∧ ¬DCLR_ID THEN
00200 BEGIN "COMMENT"
00300 INPUTSTR ← LIT_ENTITY & INPUTSTR ;
00400 DO RD(TO_SEMI_SKIP) UNTIL BRC=";" ∨ INPUTSTR=VT ;
00500 IF BRC ≠ ";" THEN BEGIN WARN("=","Unterminated COMMENT;") ; INPUTSTR←BRC&INPUTSTR END ;
00600 EMPTYTHIS ; EMPTYTHAT ; ;
00700 END "COMMENT" ;
00800 ie 7 ... macro name ; IF ¬DCLR_ID THEN
00900 BEGIN "EXPAND MACRO"
01000 INTEGER MACIX, MACSYM, ARGS, ARG, ARGSYM, NAMES, K ; BOOLEAN WASLPAR, DO_IT, DUMSEMI ;
01100 DO_IT ← ON OR ODDMAC(IX) ; comment Whether to actually expand it, or make it NULL;
01200 MACIX ← IX ; MACSYM ← SYMB ; ARGS ← NUMARGS(MACIX) ; DUMSEMI ← FALSE ;
01300 IF ARGS THEN
01400 BEGIN "SCAN ARGS"
01500 STRING ARRAY ACTUAL[1:ARGS] ;
01600 IF ¬(WASLPAR ← NEXTSCH("(")) THEN INPUTSTR ← LIT_ENTITY&LIT_TRAIL&INPUTSTR ;
01700 comment , Back up. Pretend just passed comma. ; THISWD ← "," ; EMPTYTHAT ;
01800 NAMES ← NAMEPAR(MACIX) ; comment bit table for name parameters ;
01900 FOR ARG ← 1 THRU ARGS DO
02000 BEGIN "EACH ACTUAL"
02100 IF ¬ITSCH(",") THEN ACTUAL[ARG] ← NULL comment , omitted argument;
02200 ELSE BEGIN RD(TO_VISIBLE) ;
02300 IF NAMES LAND 2↑(ARGS-ARG) = 0 THEN
02400 BEGIN PASS ; ACTUAL[ARG] ← E(NULL, NULL&'0) ; END
02500 ELSE BEGIN "CALL BY NAME"
02600 IF BRC ≠ """" THEN
02700 BEGIN comment , Unquoted Call-By-Name ;
02800 IF (K←BRC)="|" THEN RD(ONE_CHAR) ;
02900 ACTUAL[ARG]←RD(IF K="|" THEN TO_VBAR_SKIP
03000 ELSE IF WASLPAR THEN TO_COMMA_RPAR ELSE TO_TERQ_CR) ;
03100 IF BRC=CR ∧ ¬WASLPAR THEN
03200 BEGIN comment force a semicolon ;
03300 INPUTSTR ← ";" & INPUTSTR ;
03400 DUMSEMI ← TRUE ;
03500 END ;
03600 PASS ;
03700 END
03800 ELSE BEGIN PASS ; ACTUAL[ARG]←E(NULL,0) END ;
03900 END "CALL BY NAME"
04000 END
04100 END "EACH ACTUAL" ;
00100 WHILE ITSCH(",") DO
00200 BEGIN
00300 WARN("=","Too Many Arguments to "&SYM[MACSYM]) ;
00400 PASS ; E(NULL, 0) ;
00500 END ;
00600 IF ITSCH(")") ∧ WASLPAR THEN BEGIN comment Easy case; END
00700 ELSE BEGIN
00800 IF WASLPAR THEN WARN("=","Missed ) After Macro Call") ;
00900 comment Back Up -- SWICH only saves THATWD ;
01000 IF THATISFULL THEN comment Unlikely; INPUTSTR ← LIT_ENTITY&LIT_TRAIL&INPUTSTR ;
01100 IF THISISFULL ∧ ¬DUMSEMI THEN BEGIN THATWD ← LIT_ENTITY ← THISWD ;
01200 LIT_TRAIL ← IF THISTYPE<-1 THEN NULL ELSE SP ;
01300 THATTYPE ← THISTYPE MIN 0 END ELSE EMPTYTHAT ;
01400 END ;
01500 IF DO_IT THEN
01600 BEGIN "STACK ARGUMENTS"
01700 IF LAST + ARGS > SIZE THEN GROWNESTS ;
01800 FOR ARG ← 1 THRU ARGS DO
01900 SNEST[LAST + ARG] ← ACTUAL[ARG] ;
02000 LAST ← LAST + ARGS ;
02100 END "STACK ARGUMENTS" ;
02200 END "SCAN ARGS" ;
02300 IF DO_IT THEN SWICH(SSTK[BODY(MACIX)], -1, ARGS)
02400 ELSE BEGIN THISWD ← "7" ; THISTYPE ← -1 END ; ie, Replace by NULL ("") ;
02500 END "EXPAND MACRO" ;
02600 END COMMENT DETECT ; UNTIL (FINAL ← ¬FINAL) ;
02700 END "LOAD WD 0" UNTIL THISISFULL ;
02800 RETURN(NULL) ;
02900 END "PASS" ;
00100 INTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
00200 COMMENT Scan a SAIL-Like <Expression>. First check trivial case. ;
00300 IF ITS(IF) THEN
00400 BEGIN "CONDITIONAL EXPRESSION"
00500 STRING BOOLX, THENX, ELSEX ; BOOLEAN WASON ;
00600 WASON ← ON ; PASS ;
00700 BOOLX ← E(NULL, "THEN") ; ON ← WASON ∧ TRUESTR(BOOLX) ;
00800 IF ITS(THEN) THEN PASS ELSE WARN("=","Missed THEN in conditional expression "&THISWD) ;
00900 THENX ← E(NULL, "ELSE") ;
01000 IF ITS(ELSE) THEN
01100 BEGIN
01200 ON ← WASON ∧ FALSTR(BOOLX) ; PASS ;
01300 ELSEX ← E(NULL, STOPWORD) ;
01400 END
01500 ELSE ELSEX ← NULL ;
01600 ON ← WASON ;
01700 RETURN(IF TRUESTR(BOOLX) THEN THENX ELSE ELSEX) ;
01800 END "CONDITIONAL EXPRESSION"
01900 ELSE IF THISTYPE = -TERQ ∨ THISTYPE = MANTYPE ∨ ITSV(STOPWORD) THEN
02000 RETURN(DEFAULT) comment omitted expression ;
02100 ELSE IF THISTYPE ≥ -1 ∧ (THATTYPE = -TERQ ∨ THATTYPE=MANTYPE ∨ NEXTSV(STOPWORD)) THEN
02200 RETURN(SPASS("IF THISISCON THEN THISWD[2 TO ∞] ELSE VEVAL"))
02300 ELSE IF THISISID ∧ NEXTSCH(←) THEN comment, Assignment Expression ;
02400 RETURN(VASSIGN(SYMB, THISTYPE, IX, E(IPASS(PASS), STOPWORD)))
02500 ELSE
02600 BEGIN "SIMPLE EXPRESSION"
02700 STRING ANY, comment, result of A∨B∨...: has value of first TRUE operand;
02800 ALL, comment, result of A∧B∧...: has value of first FALSE operand;
02900 COMPARE, comment, result of A<B≤...: TRUE if all relations are TRUE;
03000 LEFT, comment, preceding right comparator, saved for another comparison;
03100 BOUNDARY, comment, result of A MAX B MIN... ;
03200 PRODUCT, comment, result of * / MOD & ;
03300 PRIMARY ; comment, <const>|<var>|( <expr> )|<unary><primary>|<primary><substr spec> ;
03400 INTEGER OROP, comment, =0 signals ∨ waiting for right operand ;
03500 ANDOP, NOTOP, comment, =0 signals ∧ or ¬ operator waiting ;
03600 RELOP, ODDOP, BOUNDOP, ADDOP, MULOP, comment, ≥0 signals operator waiting ;
03700 UNARYOP, comment, ≥0 signals unary operators waiting ;
03800 U, comment, last of a series of unary operators ;
03900 SS1, comment, starting byte number in substring spec ;
04000 SAVEINF, comment, saved outside value of ∞ ;
04100 SYMPTR, comment, symbol table number of identifier ;
04200 IDTYPE, comment, type field in its NUMBER entry ;
04300 ICOMPARE, ILEFT, IBOUNDARY, ISUM, IPRODUCT, IPRIMARY ; comment, CVD(corresponding string);
04400 BOOLEAN WASONA, WASONO ; comment value of ON before a series of conjuncts or disjuncts ;
04500 DEFINE TRYFAMILY(FAM) = "IF THISTYPE=-FAM THEN IPASS(IX)";
00100 COMMENT Multiple Unary operators ( + , - , ABS , LENGTH , and ↑ ) are combined
00200 into a single operator by inventing new operators such as
00300 "-ABS" and "ABS LENGTH" ;
00400 DEFINE P = "0", comment, +X ; M = "1", comment, -X ; A = "2", comment, ABS X ;
00500 MA = "3", comment, -ABS X ; C = "4", comment, ↑X ;
00600 L = "5", comment, LENGTH(X) ; ML = "6", comment -LENGTH(X) ;
00700 AL = "7", comment, ABS LENGTH(X) ; MAL = "8"; comment, -ABS LENGTH(X) ;
00800 PRELOAD_WITH comment RIGHT OPERATOR
00900 ------------------------
01000 LEFT OPERATOR + - ABS ↑ LENGTH
01100 ------------- --- --- --- --- --------
01200 none; P, M, A, C, L,
01300 comment P ; P, M, A, P, L,
01400 comment M ; M, P, MA, M, ML,
01500 comment A ; A, A, A, A, AL,
01600 comment MA ; MA, MA, MA, MA, MAL,
01700 comment C ; P, M, A, C, L ;
01800 OWN INTEGER ARRAY COMBINE[-1:4,0:4] ;
01900 COMMENT This is a top-down expression parser, but iteration is used
02000 instead of recursion for rapidity ;
02100
02200 OROP ← ANDOP ← NOTOP ← RELOP ← BOUNDOP ← ADDOP ← MULOP ← -1 ;
02300 WASONO ← ON ;
02400 DO BEGIN "DISJUNCTS" ie Operands of ∨ ;
02500 WASONA ← ON ;
02600 DO BEGIN "CONJUNCTS" ie Operands of ∧ ;
02700 WHILE THISTYPE = -NOTQ DO BEGIN NOTOP ← -1 - NOTOP ; PASS END ;
02800 ICOMPARE ← TRUE ;
02900 DO BEGIN "COMPARATORS" ie Operands of < = etc. ;
03000 ODDOP ← TRYFAMILY(ODDQ) ELSE -1 ;
03100 DO BEGIN "BOUNDS" ie Operands of MAX and MIN ;
03200 DO BEGIN "TERMS" ie Operands of + - ≡ ⊗ ;
03300 DO BEGIN "FACTORS" ie Operands of * / MOD & ;
03400 UNARYOP ← -1 ; ie check for Unary Operators ;
03500 WHILE UNARYOP≤3 ie no, P, M, A, or MA left operator ;
03600 AND 0 ≤ (U ← TRYFAMILY(ADDQ) ELSE -1) ie some right operator ;
03700 DO UNARYOP ← COMBINE[UNARYOP, U] ;
03800 comment PRIMARY ;
03900 IF THISISCON THEN BEGIN PRIMARY ← THISWD[2 TO ∞] ; PASS END
04000 ELSE IF THISISID THEN
04100 IF ITSV(STOPWORD) THEN
04200 BEGIN
04300 PRIMARY ← DEFAULT ;
04400 WARN("=","Ill-Formed Expression" & THISWD) ;
04500 END
04600 ELSE BEGIN PRIMARY ← VEVAL ; PASS END
04700 ELSE IF ITSCH("(") THEN
04800 BEGIN "( <EXPR> )"
04900 PASS ; PRIMARY ← E(DEFAULT, 0) ;
05000 IF ITSCH(")") THEN PASS ELSE WARN("=","Missed )") ;
05100 END "( <EXPR> )"
05200 ELSE BEGIN WARN("=","Ill-Formed expression" & THISWD) ; PRIMARY ← DEFAULT END ;
00100 WHILE THISTYPE=-BROKQ DO ie Substring Specifications ;
00200 BEGIN "SUBSPEC"
00300 PASS ; SAVEINF ← INF ; INF ← LENGTH(PRIMARY) ;
00400 SS1 ← CVD(E("1", IF NEXTS(TO) THEN "TO" ELSE "FOR")) ;
00500 IF ITS(TO) THEN BEGIN PASS ; PRIMARY←PRIMARY[SS1 TO CVD(E("0",0))] END
00600 ELSE IF ITS(FOR) THEN BEGIN PASS ; PRIMARY←PRIMARY[SS1 FOR CVD(E("1",0))] END
00700 ELSE PRIMARY ← PRIMARY[SS1 FOR 1] ;
00800 MANUS_SKIP_ ← _SKIP_ ;
00900 IF ITSCH(]) THEN PASS ELSE WARN("=","Missed ] in substring spec " & THISWD) ;
01000 INF ← SAVEINF ;
01100 END "SUBSPEC" ;
01200 IF UNARYOP≤3 THEN IPRIMARY ← CVD(PRIMARY) ; ie both int & str versions maintained when needed ;
01300 IF UNARYOP ≥ 0 THEN IF UNARYOP=C THEN IPRIMARY←CVD(PRIMARY←CAPITALIZE(PRIMARY))
01400 ELSE PRIMARY ← CVS(IPRIMARY ← CASE UNARYOP OF (IPRIMARY, -IPRIMARY,
01500 ABS IPRIMARY, -ABS IPRIMARY, 0, LENGTH(PRIMARY), -LENGTH(PRIMARY),
01600 ABS LENGTH(PRIMARY), -ABS LENGTH(PRIMARY) ) ) ;
01700 IF MULOP<0 THEN BEGIN PRODUCT ← PRIMARY ; IPRODUCT ← IPRIMARY END
01800 ELSE IF MULOP = 3 THEN IPRODUCT ← CVD(PRODUCT ← PRODUCT & PRIMARY)
01900 ELSE PRODUCT ← CVS(IPRODUCT ← IF IPRIMARY=0 ∨ ¬ON THEN 0 ELSE CASE MULOP OF
02000 (IPRODUCT*IPRIMARY, IPRODUCT DIV IPRIMARY, IPRODUCT MOD IPRIMARY) ) ;
02100 MULOP ← TRYFAMILY(MULQ) ELSE -1 ;
02200 END "FACTORS" UNTIL MULOP < 0 ;
02300
02400 ISUM ← CASE ADDOP+2 OF (IPRODUCT, IPRODUCT, ISUM + IPRODUCT,
02500 ISUM - IPRODUCT, ISUM ≡ IPRODUCT, ISUM ⊗ IPRODUCT) ;
02600 ADDOP ← TRYFAMILY(ADDQ) ELSE IF ADDOP<0 THEN -1 ELSE -2 ;
02700 END "TERMS" UNTIL ADDOP < 0 ;
02800
02900 IBOUNDARY ← CASE BOUNDOP+2 OF (ISUM, ISUM, IBOUNDARY MAX ISUM, IBOUNDARY MIN ISUM) ;
03000 BOUNDOP ← TRYFAMILY(BOUNDQ) ELSE IF ADDOP=-1 ∧ BOUNDOP<0 THEN -1 ELSE -2 ;
03100 END "BOUNDS" UNTIL BOUNDOP < 0 ;
03200 BOUNDARY ← IF BOUNDOP = -1 THEN PRODUCT ie, hasn't changed since then; ELSE CVS(IBOUNDARY) ;
03300 IF ODDOP≥0 THEN BOUNDARY←CVS(IBOUNDARY←(IBOUNDARY MOD 2)=ODDOP);
03400 IF ICOMPARE THEN CASE RELOP+2 OF BEGIN comment SAIL Bug precludes case expression with relationals;
03500 BEGIN END ; BEGIN END ; ICOMPARE←ILEFT<IBOUNDARY; ICOMPARE←ILEFT>IBOUNDARY; ICOMPARE ←
03600 EQU(LEFT,BOUNDARY); ICOMPARE←ILEFT≤IBOUNDARY; ICOMPARE←ILEFT≥IBOUNDARY;
03700 ICOMPARE←¬EQU(LEFT,BOUNDARY) END ;
03800 RELOP ← TRYFAMILY(RELQ) ELSE IF RELOP < 0 THEN -1 ELSE -2 ;
03900 LEFT ← BOUNDARY ; ILEFT ← IBOUNDARY ;
04000 END "COMPARATORS" UNTIL RELOP < 0 ;
04100 COMPARE ← IF RELOP=-1 THEN BOUNDARY ELSE CVS(ICOMPARE) ;
04200 IF NOTOP = 0 THEN COMPARE ← IF TRUESTR(COMPARE) THEN "0" ELSE "-1" ;
04300 NOTOP ← -1 ;
04400 IF ANDOP < 0 OR TRUESTR(ALL) THEN IF FALSTR(ALL ← COMPARE) THEN ON ← FALSE ;
04500 ANDOP ← TRYFAMILY(ANDQ) ELSE -1 ; ALL ← ALL ; comment SAIL bug -- force it to store;
04600 END "CONJUNCTS" UNTIL ANDOP < 0 ;
04700 ON ← WASONA ;
04800 IF OROP < 0 OR FALSTR(ANY) THEN IF TRUESTR(ANY ← ALL) THEN ON ← FALSE ;
04900 OROP ← TRYFAMILY(ORQ) ELSE -1 ; ANY ← ANY ; comment SAIL bug -- force it to store ;
05000 END "DISJUNCTS" UNTIL OROP < 0 ;
05100 ON ← WASONO ;
05200 RETURN(DUMMYSTR ← ANY) ; comment, DUMMYSTR due to SAIL RECURSIVE STRING PROCEDURE bug (see DCS);
05300 END "SIMPLE EXPRESSION" ;
00100 STRING SIMPLE PROCEDURE DEFN(BOOLEAN SUBSTVARIABLES,FORFILE; INTEGER ARGS, IBASE) ;
00200 BEGIN
00300 STRING SEGMENT, IDENT, PSPCS, SPCS, FML, TXID, TX2 ; INTEGER SINDX, I, DEEP ; LABEL FORMAL ;
00400 IF ITSCH(;) THEN PASS ; DEFINING ← NOT FORFILE ; comment, makes RD include line nos in result ;
00500 IF ¬ITSCH(⊂) AND NOT(ITSCH($) AND NEXTSCH("("))
00600 THEN BEGIN WARN("=","Missed ⊂ OR $( in definition") ; RETURN(NULL) END ;
00700 DEEP ← 1 ; SINDX ← SHIGH ;
00800 IF SHIGH+20>STSIZE THEN
00900 BEGIN
01000 SGROW(STBL,STBLIDA,STSIZE,100,"Definition") ;
01100 SMAKEBE(STBLIDA, STBL) ; ZEROSTRINGS(100, STBL[STSIZE-99]) ;
01200 END ;
01300 EMPTYTHIS ; comment For page label switch in LABELREF ;
01400 IF FORFILE THEN STBL[SINDX←SINDX+1] ← SRCLINE & "/" & SRCPAGE & TB & ALTMODE ;
01500 IF EQU(INPUTSTR[1:2], "}"&VT) THEN
01600 BEGIN
01700 STBL[SINDX ← SINDX + 1] ← CRLF & SRCLINE & "/" & SRCPAGE & TB ;
01800 INPUTSTR ← INPUTSTR[3:∞] ;
01900 END ;
02000 WHILE DEEP DO
02100 BEGIN "DEF BODY"
02200 SEGMENT ← RD(DEFN_TABLE) ;
02300 IF BRC = "⊂" ∨ BRC="$"∧INPUTSTR="("∧LOP(INPUTSTR)="(" THEN
02400 BEGIN DEEP ← DEEP + 1 ; SEGMENT ← SEGMENT & "⊂" ; END
02500 ELSE IF BRC = "⊃" ∨ BRC=")"∧INPUTSTR="$"∧LOP(INPUTSTR)="$" THEN
02600 BEGIN DEEP ← DEEP - 1 ;
02700 SEGMENT ← SEGMENT & (IF DEEP THEN "⊃" ELSE SP) ;
02800 END
02900 ELSE IF BRC = "∃" THEN SEGMENT ← SEGMENT & (IF DEEP>1 THEN BRC ELSE NULL) & RD(ONE_CHAR)
03000 ELSE IF LENGTH(TXID←BRC) ∧
03100 (LDB(SPCODE(BRC))=LCURLY ∨
03200 LDB(SPCODE(BRC))=DOLLAR ∧ LDB(SPCODE(INPUTSTR))=LBRACK ∧
03300 LENGTH(TXID←TXID&LOP(INPUTSTR))) THEN
03400 IF SUBSTVARIABLES THEN
03500 BEGIN "{..."
03600 SPCS ← TXID & RD(TO_VISIBLE) ;
03700 IDENT ← SCAN(INPUTSTR,ALPHA,DUMMY) ; PSPCS ← RD(TO_VISIBLE) ;
03800 IF BRC = "}" ∨ BRC="]"∧INPUTSTR[2 FOR 1]="$"THEN
03900 BEGIN
04000 LOPP(INPUTSTR) ;
04100 IF BRC="]" THEN BEGIN TX2←"]$" ; LOPP(INPUTSTR) END ELSE TX2←"⎇" ;
04200 SEGMENT ← SEGMENT &
04300 (IF FULSTR(IDENT) ∧ SIMLOOK(CAPITALIZE(IDENT)) THEN
04400 IF SYMIX=IXPAGE THEN ALTMODE&"[@]"&
04500 LABELREF(0,
04600 IF SYMBOL=SYMPAGE THEN CTR_CHRS(IXPAGE)
04700 ELSE PATT_CHRS(IXPAGE))
04800 ELSE EVALV(IDENT, SYMIX, SYMTYPE)
04900 ELSE SPCS & IDENT & PSPCS & TX2)
05000 END
05100 ELSE SEGMENT ← SEGMENT & SPCS & IDENT & PSPCS ;
05200 END "{..."
05300 ELSE SEGMENT ← SEGMENT & TXID
05400 ELSE IF BRC = "}" THEN
05500 IF EQU(INPUTSTR[1:2], "}"&VT) THEN ELSE SEGMENT ← SEGMENT & BRC
05600 ELSE IF LDB(FAMILY(BRC)) = LETTQ THEN
05700 BEGIN "LETTER"
05800 IDENT ← (BRC+0) & SCAN(INPUTSTR, ALPHA, BRC) ;
05900 FOR I ← 1 THRU ARGS DO IF EQU(FML←SYM[ITBL[IBASE+I]], TXID←CAPITALIZE(IDENT)) THEN
06000 FORMAL: BEGIN IDENT ← VT & I ; DONE END
06100 ELSE IF 1 ≤ LENGTH(TXID)-LENGTH(FML) ≤ 2 THEN
06200 BEGIN "MAYBE UNDERLINED"
06300 INTEGER L, R ;
06400 L ← IF TXID="_" THEN 1 ELSE 0 ; R ← IF TXID[∞ FOR 1]="_" THEN 1 ELSE 0 ;
06500 IF EQU(FML, TXID[1+L TO ∞-R]) THEN
06600 BEGIN
06700 IF L THEN SEGMENT ← SEGMENT & "_" ;
06800 IF R THEN INPUTSTR ← "_" & INPUTSTR ;
06900 GO TO FORMAL ;
07000 END ;
07100 END "MAYBE UNDERLINED" ;
07200 SEGMENT ← SEGMENT & IDENT ;
07300 END "LETTER"
07400 ELSE SEGMENT ← SEGMENT & BRC ;
07500 STBL[SINDX ← SINDX+1] ← SEGMENT ;
07600 IF SINDX = SHIGH+20 THEN
07700 BEGIN
07800 SEGMENT ← STBL[SHIGH + 1] ;
07900 FOR I ← SHIGH + 2 THRU SINDX DO BEGIN SEGMENT ← SEGMENT & STBL[I] ; STBL[I]←NULL; END;
08000 SINDX ← SHIGH + 1 ; STBL[SINDX] ← SEGMENT ;
08100 END ;
08200 END "DEF BODY" ;
08300 SEGMENT ← STBL[SHIGH+1] ; FOR I ← SHIGH+2 THRU SINDX DO SEGMENT ← SEGMENT & STBL[I] ;
08400 IF FORFILE THEN SEGMENT ← SEGMENT & LF ;
08500 DEFINING ← FALSE ; INPUTSTR ← ";" & INPUTSTR ; PASS ;
08600 RETURN(SEGMENT) ;
08700 END "DEFN" ;
00100 RECURSIVE PROCEDURE PARAMS(INTEGER MOST; STRING ARRAY PRE,PAR,POST);
00200 BEGIN comment, Reads arguments for various commands;
00300 INTEGER I, PREWD, SOFAR ; STRING EXPR ;
00400 LABEL RDPAR, SETPAR ;
00500 BOOLEAN GOT ; DEFINE FIND = "FOR I ← 1 THRU MOST DO IF" ;
00600 SOFAR ← I ← GOT ← 0 ;
00700 WHILE SOFAR<MOST ∧ THISTYPE≠-TERQ ∧ THISTYPE≠MANTYPE DO
00800 BEGIN "PARAMETER"
00900 IF THISISID THEN
01000 BEGIN "IDENTIFIER"
01100 IF ITS(TO) ∧ I<MOST ∧ ITSV(PRE[I+1]) THEN BEGIN PASS; I←I+1; GO TO RDPAR END;
01200 FIND ITSV(PRE[I]) ∨ ITSV(PRE[I]&"S") THEN
01300 BEGIN "PRE WORD"
01400 PASS ; IF GOT LAND 2↑I THEN WARN("=",PRE[I]&" Twice") ;
01500 GO TO RDPAR ;
01600 END "PRE WORD" ;
01700 END "IDENTIFIER" ;
01800 FIND ¬GOT LAND 2↑I ∧ NULSTR(PRE[I]) ∧ (I=1 ∨ NULSTR(PRE[I-1]) ∨ GOT LAND 2↑(I-1)) THEN GO TO RDPAR ;
01900 DONE ;
02000 RDPAR:
02100 PREWD ← I ;
02200 EXPR ← IF EQU(PRE[I],"IN") ∧ FULSTR(PAR[I]) THEN SPASS(THISWD) comment COUNT...IN -- ;
02300 ELSE IF ITSCH(⊂) THEN 0 & DEFN(FALSE, FALSE, 0, 0)
02400 ELSE E(NULL,IF I=MOST∨FULSTR(POST[I]) THEN POST[I] ELSE PRE[I+1]) ;
02500 IF FULSTR(POST[I]) THEN
02600 IF ITSV(POST[I]) THEN PASS
02700 ELSE BEGIN "GUESSED WRONG"
02800 FIND ITSV(POST[I]) THEN BEGIN PASS ; GO TO SETPAR END ;
02900 FIND NULSTR(POST[I]) THEN GO TO SETPAR ;
03000 WARN("=",POST[PREWD] & "Missed.") ;
03100 DONE ;
03200 END "GUESSED WRONG" ;
03300 SETPAR:
03400 IF PRE[I]≠PRE[PREWD] THEN WARN("=",(IF FULSTR(POST[PREWD]) THEN POST[PREWD] ELSE PRE[I])& " Missed.") ;
03500 IF GOT LAND 2↑I THEN WARN("=","Duplicate Parameter "&PRE[I]&SP&EXPR&SP&POST[I])
03600 ELSE SOFAR ← SOFAR + 1 ;
03700 GOT ← GOT LOR 2↑I ;
03800 PAR[I] ← EXPR ;
03900 IF ITSCH(",") THEN PASS ;
04000 END "PARAMETER" ;
04100 END "PARAMS" ;
04200
04300 RECURSIVE STRING PROCEDURE SIMPAR ;
04400 RETURN(IF THISISCON THEN THISWD[2 TO ∞] ELSE IF THISISID THEN VEVAL ELSE NULL) ;
00100 SIMPLE PROCEDURE FINPORTION ;
00200 BEGIN
00300 DBREAK ;
00400 IF OLDPGIDA THEN NEXTPAGE ;
00500 END "FINPORTION" ;
00600
00700 RECURSIVE PROCEDURE DAREA(BOOLEAN TITAREA) ;
00800 BEGIN
00900 INTEGER I, IX, SYMB, TEMP, A, B ;
01000 PRELOAD_WITH "LINE", "TO", "CHAR", "TO", "IN", "COLUMN", "COLUMN" ;
01100 OWN STRING ARRAY PRE[1:7] ; STRING ARRAY PAR[1:7] ;
01200 PRELOAD_WITH NULL, NULL, NULL, NULL, NULL, "WIDE", "APART" ;
01300 OWN STRING ARRAY POST[1:7] ;
01400 DBREAK; DPASS ;
01500 IF ¬THISISID THEN BEGIN WARN("=","AREA MUST HAVE NAME"); THISWD←"!DUMMY" END ;
01600 SYMB ← SYMNUM(THISWD) ;
01700 PASS ;
01800 PARAMS(7, PRE, PAR, POST) ;
01900 IF ¬ON THEN RETURN ;
02000 BIND(DECLARE(SYMB, AREATYPE), IX←PUSHI(AREAWDS,AREATYPE)) ;
02100 IF FULHIGH(IX)←NULSTR(PAR[1]) THEN BEGIN A←1 ; B←FHIGH END comment assume LINE 1 TO <frame height> ;
02200 ELSE BEGIN A ← CVD(PAR[1]) ; B ← IF NULSTR(PAR[2]) THEN A ELSE CVD(PAR[2]) END ;
02300 LINE1(IX) ← A MAX 1 ; LINECT(IX) ← B-A+1 MAX 1 ;
02400 IF FULWIDE(IX)← NULSTR(PAR[3]) THEN BEGIN A←1 ; B←FWIDE END
02500 ELSE BEGIN A ← CVD(PAR[3]) ; B ← IF NULSTR(PAR[4]) THEN A ELSE CVD(PAR[4]) END ;
02600 CHAR1(IX) ← A MAX 1 ; CHARCT(IX) ← B←B-A+1 MAX 1 ;
02700 TEXTAR(IX) ← IF TITAREA THEN 0 ELSE 1 ;
02800 IF NULSTR(PAR[5]) THEN A ← 1 comment Assume IN 1 COLUMNS <charct> WIDE ;
02900 ELSE BEGIN "COLUMNS"
03000 A ← CVD(PAR[5]) ; comment How many ;
03100 IF FULSTR(PAR[6]) THEN B ← CVD(PAR[6]) MIN B DIV A
03200 ELSE B ← (B+( TEMP←IF FULSTR(PAR[7]) THEN CVD(PAR[7]) ELSE 5 )) DIV A - TEMP ;
03300 END "COLUMNS" ;
03400 COLCT(IX) ← A MAX 1 ; COLWID(IX) ← B MAX 1 ;
03500 OLMAX ← OLMAX + A*LINECT(IX) ;
03600 FOOTSTR(IX) ← PUSHS(1, NULL) ;
03700 END "DAREA" ;
00100 SIMPLE PROCEDURE DBELOW ;
00200 BEGIN
00300 END "DBELOW" ;
00400
00500 PROCEDURE DBLANKPAGE ;
00600 BEGIN COMMENT LEAVE N BLANK PAGES WITHOUT AFFECTING THE PAGE NUMBER ;
00700 INTEGER I, J, N ;
00800 PASS ; N ← CVD(E("1", NULL)) ;
00900 IF ¬ON THEN RETURN ;
01000 DBREAK ;
01100 IF OLDPGIDA THEN NEXTPAGE ;
01200 IF INTER ≤ 0 THEN NOPORTION ;
01300 FOR I ← 1 THRU N DO FOR J ← PHIGH, PWIDE, -10 DO WORDOUT(INTER, J) ;
01400 END ;
01500
01600 SIMPLE PROCEDURE DCC ;
01700 BEGIN
01800 END "DCC" ;
01900
02000 SIMPLE PROCEDURE DCLOSE ;
02100 BEGIN
02200 DBREAK ; PASS ;
02300 IF ON THEN
02400 IF THISTYPE=AREATYPE THEN CLOSEAREA(IX,FALSE)
02500 ELSE IF IX=IXPAGE THEN comment, * * * * * * * * * * * * * ;
02600 ELSE WARN("=","CLOSE What? "&SOMEINPUT) ;
02700 PASS ;
02800 END "DCLOSE" ;
02900
03000 SIMPLE PROCEDURE DCOMMANDCHARACTER ;
03100 BEGIN
03200 INTEGER X ;
03300 INPUTSTR ← ";;" & INPUTSTR ; COMMENT couple extra semicolons to assure next line read right ;
03400 PASS ; X ← SIMPAR ;
03500 IF LENGTH(X) ≠ 1 THEN WARN("=","COMMAND CHARACTER must be a single character, not `"&X&"'")
03600 ELSE IF ON THEN COMMAND_CHARACTER ← X ;
03700 PASS ; PASS ; PASS ;
03800 END "DCOMMANDCHARACTER" ;
03900
04000 SIMPLE PROCEDURE DCOUNT ;
04100 BEGIN
04200 INTEGER USYMB, INLINE ;
04300 PRELOAD_WITH "FROM", "TO", "BY", "IN", "PRINTING" ;
04400 OWN STRING ARRAY PRE[1:5] ; OWN STRING ARRAY PAR[1:5] ;
04500 DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unit must have a name") ; THISWD ← "!DUMMY" END ;
04600 USYMB ← SYMNUM(THISWD) ; PASS ; IF ITS(INLINE) THEN BEGIN INLINE←TRUE; PASS END ELSE INLINE←FALSE ;
04700 PAR[4] ← 0 ; PARAMS(5, PRE, PAR, NULLS) ;
04800 IF ON THEN CREUNIT( INLINE,
04900 IF NULSTR(PAR[1]) THEN 1 ELSE CVD(PAR[1]), comment, FROM -- ;
05000 IF NULSTR(PAR[2]) THEN 18 ELSE CVD(PAR[2]), comment, TO -- ;
05100 IF NULSTR(PAR[3]) THEN 1 ELSE CVD(PAR[3]), comment, BY -- ;
05200 IF PAR[4] = 0 THEN 0 ELSE SYMNUM(PAR[4]), comment IN -- ;
05300 IF NULSTR(PAR[5]) THEN "1" ELSE PAR[5], comment, PRINTING -- ;
05400 USYMB ) ;
05500 END "DCOUNT" ;
05600
05700 SIMPLE PROCEDURE DDEVICE ;
05800 BEGIN PASS ;
05900 IF DEVICE ≥ 0 THEN COMMENT IF <0, WAS SET BY /SWITCH, WHICH TAKES PRECEDENCE ;
06000 IF ITS(MIC) THEN DEVICE←MIC ELSE IF ITS(TTY) THEN DEVICE←TTY
06100 ELSE IF ITS(LPT) THEN DEVICE←LPT ELSE WARN("=","No such device: "&THISWD) ;
06200 PASS ;
06300 END "DDEVICE" ;
00100 RECURSIVE PROCEDURE DCONDITIONAL ;
00200 BEGIN
00300 BOOLEAN WASON ;
00400 WASON ← ON ; PASS ; ON ← TRUESTR("E(NULL,""THEN"")") ∧ WASON ;
00500 IF ITS(THEN) THEN PASS ELSE WARN("=","Missed THEN in conditional statement "&THISWD) ;
00600 STATEMENT;
00700 IF ITS(ELSE) THEN BEGIN ON←WASON∧¬ON; PASS ; STATEMENT END ;
00800 ON ← WASON ;
00900 END "DCONDITIONAL" ;
01000
01100 RECURSIVE PROCEDURE DFRAME(BOOLEAN BOXFRM) ;
01200 BEGIN
01300 INTEGER L, I ;
01400 PRELOAD_WITH "HIGH", "WIDE" ; OWN STRING ARRAY POST[1:2];
01500 STRING ARRAY PAR[1:2] ;
01600 DAPART ; PASS ; PARAMS(2,NULLS,PAR,POST);
01700 IF ON THEN
01800 IF BOXFRM THEN BEGIN END
01900 ELSE
02000 BEGIN
02100 PHIGH←FHIGH←IF NULSTR(PAR[1]) THEN 1 ELSE CVD(PAR[1]) ;
02200 PWIDE←FWIDE←IF NULSTR(PAR[2]) THEN 1 ELSE CVD(PAR[2]) ;
02300 IF OLDPGIDA THEN NEXTPAGE ;
02400 L ← NULLAREAS ;
02500 WHILE L DO BEGIN
02600 I ← AREAIDA ; IDASSIGN(AREAIDA←L,THISAREA) ; L ← RH(INA) ;
02700 OPEN_ACTIVE(DEFA) ← 0 ; GOAWAY(AREAIDA) ; IF (AREAIDA←I) THEN IDASSIGN(AREAIDA,THISAREA) ;
02800 END ;
02900 NULLAREAS ← 0 ;
03000 END ;
03100 END "DFRAME" ;
03200
03300 SIMPLE PROCEDURE DINDENT ;
03400 BEGIN
03500 STRING X ;
03600 DBREAK ; PASS ; X ← E(NULL,NULL) ; IF ON ∧ FULSTR(X) THEN FIRSTIM ← CVD(X) ;
03700 IF ITSCH(",") THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
03800 IF ON ∧ FULSTR(X) THEN RESTIM←CVD(X) ;
03900 IF ITSCH(",") THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
04000 IF ON ∧ FULSTR(X) THEN RIGHTIM←CVD(X) ;
04100 END "DINDENT" ;
00100 SIMPLE PROCEDURE DINSERT ;
00200 BEGIN
00300 INTEGER CHAN, PIX, ROTTEN ;
00400 FINPORTION ;
00500 IF INTER ≥ 0 THEN
00600 BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) ; SINTER←INTER←-1 END ;
00700 DO BEGIN "COLLATE"
00800 DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unnamed INSERT Portion!") ; RETURN END ;
00900 IF ON THEN
01000 BEGIN ROTTEN ← FALSE ;
01100 IF THISTYPE ≠ PORTYPE THEN BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -5))
01200 ELSE IF (CHAN ← PORCH(PIX ← IX)) = -1 THEN BEGIN WARN("=","Can't INSERT FOOT!"); ROTTEN←TRUE END
01300 ELSE IF ¬(0 ≤ CHAN ≤ 15) THEN BEGIN WARN("=","Can't INSERT passed Portion "&THISWD) ; ROTTEN←TRUE END ;
01400 IF ¬ROTTEN THEN BEGIN PORSEQ(SEQPORT) ← PIX ; PORSEQ(SEQPORT ← PIX) ← -1 END ;
01500 PASS ;
01600 END ;
01700 END "COLLATE" UNTIL ¬ITSCH(",") ;
01800 END "DINSERT" ;
01900
02000 SIMPLE PROCEDURE DLET ;
02100 BEGIN
02200 INTEGER LOC ; LABEL BADLET ;
02300 DPASS ; IF THATISID THEN BEGIN THATWD ← THISWD & THATWD ; DPASS END ; LOC ← SYMB ;
02400 IF ¬THISISID THEN GO TO BADLET ; PASS ; IF ¬ITSCH(=) THEN GO TO BADLET ; DPASS ;
02500 IF THISTYPE≠MANTYPE AND THATISID THEN BEGIN THATWD←THISWD&THATWD ; PASS END ;
02600 IF THISTYPE≠MANTYPE THEN GO TO BADLET ; IF ON THEN BIND(LOC←DECLARE(LOC, MANTYPE), IX) ; PASS ;
02700 RETURN ;
02800 BADLET: WARN("=","LET <ID>=<RESWD>, please!") ; DO PASS UNTIL THISISID ∨ THISTYPE=-TERQ ;
02900 END "DLET" ;
03000
03100 SIMPLE PROCEDURE DLOCK ;
03200 BEGIN
03300 END "DLOCK" ;
00100 SIMPLE PROCEDURE DLOCAL ;
00200 DO BEGIN
00300 DPASS ;
00400 IF THISISID THEN
00500 BEGIN
00600 IF ON THEN
00700 BIND(SYMB←DECLARE(SYMB, LOCALTYPE), IX←PUSHS(1,NULL)) ;
00800 PASS ;
00900 END
01000 ELSE BEGIN WARN("=","LOCAL declaration missing identifier"); IF THISTYPE≠TERQ THEN PASS END ;
01100 END UNTIL ¬ITSCH(",") ;
01200
01300 SIMPLE PROCEDURE DMACRO(BOOLEAN ODDONE) ;
01400 BEGIN
01500 INTEGER SIHIGH, MIX, ARGS, J, NAMES, NAME ; BOOLEAN ROTTEN ;
01600 SIHIGH ← IHIGH ; DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Macro name not identifier") ; RETURN END ;
01700 IF THATISID THEN BEGIN "TWO WORD" THISWD ← THISWD & SP & THATWD ; RDENTITY ; END "TWO WORD" ;
01800 PUTI(1, SYMNUM(THISWD)) ; PASS ;
01900 IF ITSCH("(") THEN
02000 BEGIN "FORMALS"
02100 ROTTEN ← FALSE ; THISWD ← "," ; NAMES ← 0 ;
02200 DO BEGIN
02300 IF ITSCH(",") THEN DPASS
02400 ELSE BEGIN WARN("=","Missed comma in macro formal list") ; ROTTEN←TRUE END ;
02500 IF ITSCH(ε) THEN BEGIN DPASS ; NAME ← 0 ; END ELSE NAME ← 1 ;
02600 IF ¬THISISID THEN BEGIN WARN("=","Formal parameters must be identifiers") ; ROTTEN←TRUE END
02700 ELSE BEGIN PUTI(1, SYMB) ; NAMES ← 2*NAMES + NAME ; DPASS END ;
02800 END
02900 UNTIL ITSCH(")") ∨ ROTTEN ;
03000 IF ITSCH(")") THEN PASS ;
03100 END "FORMALS" ;
03200 IF ROTTEN ∨ ¬ON THEN BEGIN IHIGH ← SIHIGH ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
03300 ARGS ← IHIGH - SIHIGH - 1 ; BIND(DECLARE(ITBL[SIHIGH+1], MACROTYPE), MIX←PUSHI(MACROWDS,MACROTYPE)) ;
03400 NUMARGS(MIX) ← ARGS ; ODDMAC(MIX) ← ODDONE ; BODY(MIX) ← PUSHS(1,DEFN(FALSE, FALSE,ARGS,SIHIGH+1)) ;
03500 IHIGH ← SIHIGH ; NAMEPAR(MIX) ← NAMES ;
03600 END "DMACRO" ;
00100 SIMPLE PROCEDURE DMARGINS(BOOLEAN INWARD) ;
00200 BEGIN
00300 STRING S ; INTEGER L, R, W, ARIX, OLDIX, NEWIX ;
00400 IF ON THEN DBREAK ;
00500 ARIX ← IF AREAIXM THEN AREAIXM ELSE IXTEXT ; OLDIX ← MARGINS(ARIX) ; PASS ;
00600 S ← IF THISTYPE > INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(←) ∨ NEXTSCH(:) THEN NULL
00700 ELSE E(NULL, NULL) ;
00800 IF FULSTR(S) ∨ ITSCH(",") THEN
00900 BEGIN "HAS PARAMS"
01000 L ← IF FULSTR(S) THEN CVD(S) ELSE 0 ;
01100 IF ITSCH(",") THEN BEGIN PASS ; R ← CVD(E("0",NULL)) END ELSE R ← 0 ;
01200 IF ¬ON THEN RETURN ;
01300 MARGINS(ARIX) ← NEWIX ← PUSHI(MARGWDS, MARGTYPE) ; W ← COLWID(ARIX) ;
01400 LMARG ← (IF OLDIX THEN LMARGX(OLDIX) ELSE 0) + INWARD*L MAX 0 MIN W-1 ;
01500 RMARG ← (IF OLDIX THEN RMARGX(OLDIX) ELSE W) - INWARD*R MIN W MAX LMARG+1 ;
01600 LMARGX(NEWIX) ← LMARG ; RMARGX(NEWIX) ← RMARG ;
01700 AREAX(NEWIX) ← ARIX ; OLD_MARGX(NEWIX) ← OLDIX ;
01800 END "HAS PARAMS"
01900 ELSE IF ¬ON THEN RETURN
02000 ELSE IF OLDIX THEN
02100 BEGIN "UNNEST"
02200 AREAX(OLDIX) ← 0 ; comment, so ENDBLOCK won't use it ;
02300 MARGINS(ARIX) ← NEWIX ← OLD_MARGX(OLDIX) ;
02400 LMARG ← IF NEWIX THEN LMARGX(NEWIX) ELSE 0 ;
02500 RMARG ← IF NEWIX THEN RMARGX(NEWIX) ELSE COLWID(ARIX) ;
02600 IF OLDIX = IHED THEN IHED ← IHED - 1 - MARGWDS ;
02700 END "UNNEST"
02800 ELSE WARN("=","Extra "&(IF INWARD>0 THEN "NARROW" ELSE "WIDEN")&" in Margin Nest") ;
02900 END "DMARGINS" ;
03000
03100 RECURSIVE PROCEDURE DNEXT ;
03200 BEGIN
03300 COMMENT Already PASSed "NEXT" ;
03400 IF ¬THISISID ∨ (THISTYPE ≠ UNITTYPE ∧ THISTYPE ≠ PUNITTYPE) THEN WARN("=","NEXT what?")
03500 ELSE IF ON THEN IF IX=IXPAGE THEN NEXTPAGE ELSE USTEP(SYMB, IX) ;
03600 PASS ;
03700 END "DNEXT" ;
03800
03900 SIMPLE PROCEDURE DPACK ;
04000 BEGIN
04100 END "DPACK" ;
00100 SIMPLE PROCEDURE DPORTION ;
00200 BEGIN
00300 INTEGER CHAN, PIX ; STRING IFIL ; LABEL WASFWD ;
00400 DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unnamed PORTION!") ; RETURN END ;
00500 IF ¬ON THEN BEGIN PASS ; RETURN END ;
00600 FINPORTION ;
00700 IF THISTYPE ≠ PORTYPE THEN
00800 BEGIN
00900 BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -2)) ;
01000 PORSEQ(PIX) ← 0 ;
01100 END
01200 ELSE IF 0 ≤ (CHAN ← PORCH(PIX ← IX)) THEN BEGIN RELEASE(CHAN) ; PORCH(PIX) ← -3 ; GO TO WASFWD END
01300 ELSE IF CHAN = -1 THEN BEGIN WARN("=","Can't declare PORTION FOOT!") ; PASS ; RETURN END
01400 ELSE IF CHAN ≠ -5 THEN WARN("=","PORTION "&THISWD&" already declared!")
01500 ELSE IF PORSEQ(THISPORT) ≠ PIX THEN
01600 BEGIN PORCH(PIX) ← -2 ; COMMENT ADDED FEB 6, 1973 ;
01700 WASFWD: BEGIN
01800 IF INTER ≥ 0 THEN
01900 BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) END ;
02000 INTER ← SINTER ← -1 ;
02100 END ;
02200 END ;
02300 IF INTER < 0 THEN
02400 BEGIN
02500 IFIL ← "PUI"&CVS(INTERS←INTERS+1) ;
02600 PORINT(PIX)←CVASC(IFIL) ; INTER←WRITEON(TRUE,IFIL&".PUI") ; SINTER←WRITEON(FALSE,IFIL&"S.PUI") ;
02700 END ;
02800 IF PORSEQ(PIX) = 0 THEN
02900 BEGIN
03000 PORSEQ(SEQPORT) ← PIX ;
03100 SEQPORT ← PIX ;
03200 END ;
03300 THISPORT ← PIX ; PORTS ← PORTS + 1 ;
03400 PASS ;
03500 END "DPORTION" ;
03600
03700 SIMPLE PROCEDURE DRECEIVE ;
03800 BEGIN
03900 STRING A ;
04000 IF THATISCON ∧ 1≤ LENGTH(THATWD)-1 ≤2 THEN BEGIN PASS ; A ← THISWD[2 TO ∞] END
04100 ELSE A ← NULL ;
04200 IF ON THEN RECEIVE(THISPORT, A) ; PASS ;
04300 END "DRECEIVE" ;
00100 SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD) ;
00200 BEGIN
00300 INTEGER ARGS, SIHIGH, L1, L2, SIG, CLU, VARI, S, A, RIX, J, TYP, XIX ;
00400 STRING PHR, X, BOD ; BOOLEAN ROTTEN, HASBODY ;
00500 SIMPLE PROCEDURE RESPREPL ;
00600 BEGIN
00700 RIX ← PUSHI(RESPWDS, RESPTYPE) ;
00800 NEXT_RESP(RIX) ← LLPOST ; OLD_RESP(RIX) ← LLTHIS ;
00900 END "RESPREPL" ;
01000 ROTTEN ← FALSE ; ARGS ← 0 ; SIHIGH ← IHIGH ;
01100 IF COMDWD = 1 THEN
01200 BEGIN "AT"
01300 PASS ;
01400 IF ITS(PAGEMARK) THEN BEGIN VARI←2 ; CLU←0 ; L1←FF ; SIG←FF ROT -7 ; PASS END
01500 ELSE BEGIN
01600 X ← SIMPAR ; L1 ← X ;
01700 IF NULSTR(X) THEN BEGIN VARI←2 ; CLU←0 ; L1←CR ; SIG←CR ROT -7 ; PASS END
01800 ELSE IF "0"≤L1≤"9" THEN BEGIN VARI←1 ; CLU←CVD(X) ; PASS END
01900 ELSE IF LDB(FAMILY(L1)) = 0 THEN
02000 BEGIN comment, phrase response ;
02100 VARI ← 0 ; CLU ← PUSHS(1, X) ; PHR ← X ;
02200 L1←LDB(SPECIES("LOP(X)")) ;
02300 L2←IF LDB(FAMILY(L2←X)) THEN 27 ELSE LDB(SPECIES(L2)) ;
02400 PASS ;
02500 END
02600 ELSE BEGIN VARI ← 2 ; L1 ← X ; SIG ← CVASC(X) ; CLU ← LENGTH(X) ;
02700 DPASS ; A ← 0 ;
02800 WHILE ¬(ITSCH(;) ∨ ITSCH(⊂)) DO
02900 BEGIN
03000 IF ¬THISISID THEN
03100 BEGIN
03200 WARN("=","Argument must be identifier.") ;
03300 ROTTEN←TRUE ;
03400 END ;
03500 S←SYMB ; PASS ; IF LENGTH(X←SIMPAR)≠1 THEN WARN("=","Separator 1 character only");
03600 PUTI(1, S) ; A ← A LSH 7 LOR X ; DPASS ;
03700 END ;
03800 ARGS ← IHIGH - SIHIGH ;
03900 END ;
04000 END ;
04100 END "AT"
04200 ELSE BEGIN
04300 PASS ; IF ¬THISISID THEN BEGIN WARN("=","BEFORE/AFTER need area/unit name") ; ROTTEN←TRUE END
04400 ELSE BEGIN VARI←IF COMDWD THEN 3 ELSE 4; CLU←SYMB; TYP←THISTYPE; XIX←IX; PASS END ;
04500 END ;
04600 BOD ← DEFN(FALSE, FALSE,ARGS,SIHIGH) ; RIX ← -1 ;
04700 IF ROTTEN ∨ ¬ON THEN BEGIN IHIGH ← SIHIGH ; RETURN END ;
04800 X ← BOD ; SCAN(X, TO_NON_SP, HASBODY) ; IF ¬HASBODY THEN BOD ← NULL ;
00100 CASE VARI MIN 3 OF
00200 BEGIN
00300 ie 0 ... Phrase;BEGIN
00400 LLSCAN("PHRASED[L1,L2]", NEXT_RESP, "EQU(SSTK[CLUE(LLTHIS)], PHR)" ) ;
00500 IF LLTHIS THEN
00600 IF DEPTH_RESP(LLTHIS) < DEPTH THEN
00700 BEGIN
00800 RESPREPL ;
00900 IF LLPREV<0 THEN PHRASED[L1,L2]←RIX ELSE NEXT_RESP(LLPREV) ← RIX ;
01000 END
01100 ELSE IF HASBODY THEN RIX ← LLTHIS
01200 ELSE LLSKIP("PHRASED[L1,L2]", NEXT_RESP)
01300 ELSE IF HASBODY THEN
01400 BEGIN RIX←PUSHI(RESPWDS,RESPTYPE);
01500 LLINS("PHRASED[L1,L2]",NEXT_RESP,RIX) ; END ;
01600 END ;
01700 ie 1 ... Inset ;IF FINDINSET(CLU) THEN
01800 IF DEPTH_RESP(LLTHIS) < DEPTH THEN
01900 BEGIN
02000 RESPREPL ;
02100 IF LLPREV<0 THEN LEADRESPS←RIX ELSE NEXT_RESP(LLPREV) ← RIX ;
02200 END
02300 ELSE IF HASBODY THEN RIX ← LLTHIS
02400 ELSE LLSKIP(LEADRESPS, NEXT_RESP)
02500 ELSE BEGIN
02600 RIX←PUSHI(RESPWDS,RESPTYPE) ;
02700 LLINS(LEADRESPS,NEXT_RESP,RIX) ;
02800 END ;
02900 ie 2 ... Signal;BEGIN S ← 0 ; comment Old response of same signal: >0 for outer block, <0 same block;
03000 IF FINDSIGNAL(SIG) THEN
03100 BEGIN
03200 S ← IF DEPTH_RESP(LLTHIS) < DEPTH THEN LLTHIS ELSE -LLTHIS ;
03300 LLSKIP(SIGNALD[L1], NEXT_RESP) ; LLTHIS ← LLPOST ;
03400 END ;
03500 IF HASBODY ∨ S > 0 THEN
03600 BEGIN
03700 RIX←PUSHI(SIGWDS,RESPTYPE); SIGNAL(RIX)←SIG ; NUMARGS(RIX) ← ARGS ;
03800 LLINS(SIGNALD[L1], NEXT_RESP, RIX) ; RESP_SEP(RIX) ← A ;
03900 IF S = 0 THEN SIG_BRC ← (SIG LSH -29) & SIG_BRC ; OLD_RESP(RIX) ← S MAX 0;
04000 END ;
04100 IF NULSTR(BOD) ∧ S THEN
04200 BEGIN
04300 X ← NULL ;
04400 WHILE FULSTR(SIG_BRC) ∧ (A ← LOP(SIG_BRC)) ≠ L1 DO X ← X & A ;
04500 SIG_BRC ← X & SIG_BRC ;
04600 END ;
04700 SETBREAK(TEXT_TBL, TEXT_BRC&SIG_BRC, NULL, "IS") ;
04800 END ;
00100 ie 3,4... AFTER/BEFORE area|unit ;
00200 IF FINDTRAN(CLU, VARI) THEN
00300 IF DEPTH_RESP(LLTHIS) < DEPTH THEN
00400 BEGIN
00500 RESPREPL ;
00600 IF LLPREV < 0 THEN WAITRESP←RIX ELSE NEXT_RESP(LLPREV) ← RIX ;
00700 END
00800 ELSE IF HASBODY THEN RIX ← LLTHIS ELSE LLSKIP(WAITRESP,NEXT_RESP)
00900 ELSE BEGIN
01000 RIX←PUSHI(RESPWDS,RESPTYPE) ;
01100 LLINS(WAITRESP,NEXT_RESP,RIX) ;
01200 END ;
01300 END ;
01400 IF RIX ≥ 0 THEN
01500 BEGIN
01600 CLUE(RIX) ← CLU ; VARIETY(RIX) ← VARI ;
01700 BODY(RIX) ← PUSHS(1,BOD) ; DEPTH_RESP(RIX) ← DEPTH ;
01800 END ;
01900 END "DRESPONSE" ;
02000
02100 SIMPLE PROCEDURE DREQUIRE ;
02200 BEGIN
02300 STRING F ;
02400 PASS ; F ← E(NULL, "SOURCE!FILE") ;
02500 IF ¬EQU(THISWD[1 TO 6],"SOURCE") THEN WARN("=","REQUIRE -- SOURCE_FILE only!") ;
02600 IF FULSTR(F) ∧ ON THEN SWICHF(F) ; PASS ;
02700 END "DREQUIRE" ;
02800
02900 SIMPLE PROCEDURE DSEND ;
03000 BEGIN
03100 INTEGER PIX; STRING FI ;
03200 INTEGER SIMPLE PROCEDURE OPORT ; BEGIN INTEGER CH ; CH←WRITEON(FALSE,(FI←(CVS(PORTS←PORTS+1)&THISWD)[1 TO 5])&".PUG") ;
03300 RETURN(CH) ; END "OPORT" ;
03400 PASS ; IF ¬THISISID THEN BEGIN WARN("=","SEND Where?") ; RETURN END ;
03500 IF ¬ON THEN BEGIN PASS ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
03600 IF THISTYPE ≠ PORTYPE THEN
03700 BEGIN
03800 BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, OPORT) ) ;
03900 PORSEQ(PIX) ← 0 ; PORFIL(PIX) ← CVASC(FI) ;
04000 END
04100 ELSE IF PORCH(PIX←IX)=-5 THEN BEGIN PORCH(PIX)←OPORT ; PORFIL(PIX)←CVASC(FI) END ;
04200 PASS ;
04300 SEND(PIX, DEFN(TRUE,PORCH(PIX)≠-1,0,0)) ;
04400 END "DSEND" ;
04500
04600 SIMPLE PROCEDURE DSHOW ;
04700 BEGIN
04800 END "DSHOW" ;
04900
05000 SIMPLE PROCEDURE DSUPERIMPOSE ;
05100 BEGIN
05200 INTEGER N ;
05300 DBREAK ; PASS ; N ← CVD(E("0",NULL)) MIN 50 ;IF N<1 THEN N←50 ; IF ¬ON THEN RETURN ;
05400 TWEENLFM ← N-1; SINCELFM ← 0; BREAKM ← 5;
05500 END "DSUPERIMPOSE" ;
00100 SIMPLE PROCEDURE DSKIP(BOOLEAN GRPSKIP) ;
00200 BEGIN
00300 BOOLEAN GM ;
00400 DBREAK ; PASS ; IF GRPSKIP THEN BEGIN GM←GROUPM ; GROUPM ← GROUPM←1 ; END ;
00500 IF ITS(TO) THEN
00600 BEGIN "SKIP TO"
00700 DAPART ; PASS ;
00800 IF ITS(COLUMN) THEN BEGIN PASS; TOCOLUMN(CVD(E(CVS(COL+1),NULL))) END
00900 ELSE BEGIN IF ITS(LINE) THEN PASS ; TOLINE(CVD(E("1", NULL))) END ;
01000 END "SKIP TO"
01100 ELSE SKIPLINES(IF THISTYPE>INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(←) ∨ NEXTSCH(:)
01200 THEN 1 ELSE CVD(E("1", NULL))) ;
01300 IF GRPSKIP ∧ GM = 0 THEN DAPART ;
01400 END "DSKIP" ;
01500
01600 SIMPLE PROCEDURE DTABS ;
01700 BEGIN
01800 INTEGER NUMB, I ; BOOLEAN TOO ;
01900 IF ON THEN TABSORT[1] ← 2↑33 ; TOO ← FALSE ;
02000 DO BEGIN
02100 PASS ; NUMB ← CVD(E("-9999", NULL)) MIN 9999 ;
02200 IF ON THEN
02300 BEGIN
02400 FOR I ← 1 THRU 27 DO IF TABSORT[I] ≥ NUMB THEN DONE ; IF I>27 THEN TOO←TRUE;
02500 IF ¬TOO ∧ NUMB > -9999 THEN
02600 IF TABSORT[I] > NUMB THEN DO BEGIN TABSORT[I] ↔ NUMB ; I ← I + 1 END UNTIL TABSORT[I-1]=2↑33 ;
02700 END ;
02800 END
02900 UNTIL ¬ITSCH(",") ;
03000 IF TOO THEN WARN("=","Too many Tab Stops") ;
03100 END "DTABS" ;
03200
03300 SIMPLE PROCEDURE DTURN(BOOLEAN TURNON) ;
03400 BEGIN
03500 comment TURN ON|OFF {"c" [FOR "c"]},... ;
03600 INTEGER C1, C2 ; STRING S1, S2 ;
03700 PASS ;
03800 IF THISTYPE>INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(:) ∨ NEXTSCH(←) THEN
03900 BEGIN "TURN BACK"
04000 C1 ← IHED ;
04100 WHILE C1>0 ∧ (C2←IXTYPE(C1))≠MODETYPE ∧ (C2≠TURNTYPE ∨ ISTK[C1-1]<0) DO C1 ← IXOLD(C1) ;
04200 IF C2=TURNTYPE THEN DO BEGIN TURN((C2←ISTK[C1-1]) LSH -7,C2 LAND '177,1) ;
04300 ISTK[C1-1] ← -2 ; C1 ← IXOLD(C1) END UNTIL C1≤0 ∨ IXTYPE(C1)≠TURNTYPE ∨ ISTK[C1-1]<0 ;
04400 END "TURN BACK"
04500 ELSE BEGIN "TURN CHARS"
04600 PUSHI(TURNWDS, TURNTYPE) ; ISTK[IHED-1] ← -1 ;
04700 DO BEGIN
04800 IF ITSCH(",") THEN PASS ;
04900 S1 ← IF NOT ITS(TAB) THEN SIMPAR ELSE TB ; PASS ;
05000 COMMENT 2/27/73 TES ;
05100 IF ITS(FOR) THEN BEGIN PASS ; S2 ← SIMPAR ; PASS END ELSE IF TURNON THEN S2 ← S1 ELSE S2 ← NULL ;
05200 IF ON THEN
05300 BEGIN
05400 IF 0 ≠ LENGTH(S2) ≠ LENGTH(S1) THEN
05500 WARN(NULL,"Strings each side of FOR are unequal length") ;
05600 WHILE FULSTR(S1) DO
05700 TURN(LOP(S1), IF FULSTR(S2) THEN LOP(S2) ELSE 0, TURNON) ;
05800 END ;
05900 END UNTIL ¬ITSCH(",") ;
06000 END "TURN CHARS" ;
06100 END "DTURN" ;
00100 INTEGER SIMPLE PROCEDURE COUNTERSTMT ;
00200 IF ITS(NEXT) THEN
00300 BEGIN
00400 INTEGER USYMB ; ie, unit name symbol number ;
00500 PASS ; USYMB←IF THISTYPE=UNITTYPE THEN SYMB ELSE IF THISTYPE=PUNITTYPE THEN -SYMB ELSE 2↑20 ;
00600 DNEXT ; RETURN(USYMB) ;
00700 END
00800 ELSE RETURN(0) ;
00900
01000 BOOLEAN SIMPLE PROCEDURE LABELDEF ;
01100 IF ¬NEXTSCH(:) THEN RETURN(FALSE)
01200 ELSE IF ¬ON THEN
01300 BEGIN
01400 WHILE THISISID ∧ NEXTSCH(:) DO BEGIN PASS ; PASS END ;
01500 IF ¬ COUNTERSTMT THEN E(0, 0) ; RETURN(TRUE) ;
01600 END
01700 ELSE
01800 BEGIN
01900 INTEGER LINK, PTR, PLIGHT, USYMB, WASSYMB, VALPTR ; STRING DEFVAL ;
02000 SIMPLE PROCEDURE CHECK_CONSISTENCY ;
02100 IF WASSYMB ∧ USYMB≠0 ∧ LDB(IXN(WASSYMB)) ≠ LDB(IXN(ABS(USYMB))) THEN
02200 WARN("=","Label "&SYM[LINK]&" was cross-referenced as a "&
02300 SYM[WASSYMB]&" but is being defined as a "&
02400 SYM[ABS(USYMB)]) ;
02500 LINK ← 0 ;
02600 DO BEGIN "MULTIPLE LABELS"
02700 PTR ← SYMNUM(THISWD&":") ; BYTEWD ← NUMBER[PTR] ;
02800 IF BYTEWD=0 OR ( PLIGHT ← LDB(PLIGHTWD(BYTEWD)) ) = 1 THEN
02900 BEGIN NUMBER[PTR] ← BYTEWD LSH 13 LOR LINK ; LINK ← PTR END
03000 ELSE WARN("=","Label "&SYM[PTR]&" is already defined as "&
03100 (IF PLIGHT=2 THEN STBL[IX] ELSE "a recent page number")) ;
03200 PASS ; PASS ;
03300 END "MULTIPLE LABELS"
03400 UNTIL ¬(THISISID ∧ NEXTSCH(:)) ;
03500 DEFVAL ← IF (USYMB←COUNTERSTMT)=0 THEN E(0,0)
03600 ELSE IF USYMB>2↑13 THEN "??"
03700 ELSE IF USYMB>0 THEN C! ELSE !;
03800 IF EQU(DEFVAL,0) OR USYMB = SYMPAGE THEN
03900 DO BEGIN "PAGE LABELS"
04000 NUMBER[LINK] ↔ PLBL ; WASSYMB ← PLBL LSH -13 ;
04100 CHECK_CONSISTENCY ;
04200 PLBL ↔ LINK ; LINK ← LINK LAND '17777 ; PLBL ← -PLBL ;
04300 END "PAGE LABELS"
04400 UNTIL LINK=0
04500 ELSE BEGIN "OTHER UNIT"
04600 VALPTR ← 2 ROT -2 LOR PUTS(DEFVAL) ;
04700 DO BEGIN
04800 PTR ← VALPTR ; NUMBER[LINK] ↔ PTR ; WASSYMB ← PTR LSH -13 ;
04900 CHECK_CONSISTENCY ;
05000 LINK ← PTR LAND '17777 ;
05100 END
05200 UNTIL LINK=0 ;
05300 END "OTHER UNIT" ;
05400 RETURN(TRUE) ;
05500 END "LABELDEF" ;
00100 RECURSIVE BOOLEAN PROCEDURE ASSIGNMENT ;
00200 IF NEXTSCH(←) THEN
00300 BEGIN
00400 VASSIGN(SYMB, THISTYPE, IX, E(SPASS(PASS), 0)) ;
00500 IF ITSCH(;) THEN PASS ; RETURN(TRUE) ;
00600 END
00700 ELSE RETURN(FALSE) ;
00800
00900 BOOLEAN SIMPLE PROCEDURE EMPTYCHUNK ;
01000 RETURN(IF ITSCH(;) THEN IPASS(TRUE) ELSE FALSE) ;
01100
01200 BOOLEAN SIMPLE PROCEDURE NONSENSE(BOOLEAN VALID) ;
01300 BEGIN
01400 IF VALID THEN WARN("=","Can't make sense out of: "&SOMEINPUT) ;
01500 PASS ; RETURN(FALSE) ;
01600 END "NONSENSE" ;
00100 RECURSIVE BOOLEAN PROCEDURE COMMAND ;
00200 BEGIN
00300 DEFINE DB(WHAT) = "BEGIN IF ON THEN WHAT; PASS END",
00400 BDB(WHAT)="BEGIN IF ON THEN BEGIN DBREAK; WHAT END; PASS END";
00500 IF THATISID ∧ SYMLOOK(THISWD&THATWD) ∧ LDB(TYPEN(SYMBOL))=MANTYPE THEN
00600 BEGIN THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← MANTYPE ;
00700 IX ← LDB(IXN(SYMB)) ; RDENTITY ; END
00800 ELSE IF THISTYPE ≠ MANTYPE THEN RETURN(FALSE) ;
00900 CASE IX OF
01000 BEGIN COMMENT COMMANDS ; comment THISWD is command word.;
01100 ie ADJUST ; BDB(JUSTM←1) ;
01200 ie AFTER ; DRESPONSE(2) ;
01300 ie APART ; BEGIN DAPART ; PASS END ;
01400 ie AREA ; DAREA(FALSE) ;
01500 ie AT ; DRESPONSE(1) ;
01600 ie BEFORE ; DRESPONSE(0) ;
01700 ie BEGIN ; BEGIN BEGINBLOCK(FALSE, IF ENDCASE=2 ∧ ON THEN -1 ELSE 1,
01800 IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END ;
01900 ie BELOW ; DBELOW ;
02000 ie BLANK PAGE ; DBLANKPAGE ;
02100 ie BOX FRAME ; DFRAME(TRUE) ;
02200 ie BREAK ; BEGIN DBREAK ; PASS END ;
02300 ie CC ; DCC ;
02400 ie CENTER ; BDB(BREAKM←4) ;
02500 ie CLOSE ; DCLOSE ;
02600 ie COMMAND CHARACTER ; DCOMMANDCHARACTER ;
02700 ie COMMENT ; BEGIN IMPOSSIBLE("COMMAND") ; PASS END ;
02800 ie COMPACT ; DB(SPACEM←IF FILL THEN 1 ELSE 2) ;
02900 ie CONTINUE ; BEGIN DBREAK ; NOPGPH ← 1 ; PASS END ;
03000 ie COUNT ; DCOUNT ;
03100 ie CRBREAK ; DB(CRBM←1) ;
03200 ie CRSPACE ; DB(CRBM←0) ;
03300 ie DEVICE ; DDEVICE ;
03400 ie END ; CASE IF STARTS THEN 0 ELSE ENDCASE OF BEGIN STARTEND; BEGINEND; ONCEEND; RESPEND END ;
03500 ie FILL ; BDB(BREAKM ← 0 ; SPACEM ← SPACEM MIN 1) ;
03600 ie FLUSH LEFT ; BDB(BREAKM←2) ;
03700 ie FLUSH RIGHT ; BDB(BREAKM←3) ;
03800 ie GROUP ; IF GROUPM THEN PASS ELSE BDB(GROUPM←1) ;
03900 ie GROUP SKIP ; DSKIP(TRUE) ;
04000 ie IF ; DCONDITIONAL ;
04100 ie INDENT ; DINDENT ;
04200 ie INSERT ; DINSERT ;
04300 ie JUSTJUST ; BDB(BREAKM←1) ;
04400 ie LET ; DLET ;
04500 ie LOCK ; DLOCK ;
04600 ie MACRO ; DMACRO(1) ;
00100 ie NARROW ; DMARGINS(1) ; COMMENT SEMI-OBSOLETE ;
00200 ie NEXT ; BEGIN PASS ; DNEXT END ;
00300 ie NOFILL ; BDB(BREAKM←7) ;
00400 ie NOJUST ; BDB(JUSTM←0) ;
00500 ie ONCE ; BEGIN IF ON∧ENDCASE≠2 THEN BEGIN INTEGER S ; S ← STARTS ; STARTS ← 0 ;
00600 BEGINBLOCK(FALSE,2,ALTMODE) ; STARTS ← S ; END ; PASS END ;
00700 ie PACK ; DPACK ;
00800 ie PAGE FRAME ; DFRAME(FALSE) ;
00900 ie PLACE ; BEGIN IF ON THEN DBREAK ; PASS ; PLACE(IX) ; PASS END ;
01000 ie PORTION ; DPORTION ;
01100 ie PREFACE ; BEGIN DBREAK; PASS; K←CVD(E("0",NULL)); IF ON THEN IF FILL THEN LEADFM←K ELSE LEADNM←K END ;
01200 ie RECEIVE ; DRECEIVE ;
01300 ie RECURSIVE MACRO ; DMACRO(0) ;
01400 ie REQUIRE ; DREQUIRE ;
01500 ie RETAIN ; DB(SPACEM←0) ;
01600 ie SEND ; DSEND ;
01700 ie SHOW ; DSHOW ;
01800 ie SKIP ; DSKIP(FALSE) ;
01900 ie START ; BEGIN BEGINBLOCK(FALSE,0,IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END;
02000 ie SUPERIMPOSE ; DSUPERIMPOSE ;
02100 ie TABS ; DTABS ;
02200 ie TEXT AREA ; DAREA(FALSE) ;
02300 ie TITLE AREA ; DAREA(TRUE) ;
02400 ie TURN OFF ; DTURN(0) ;
02500 ie TURN ON ; DTURN(-1) ;
02600 ie VARIABLE ; DLOCAL ;
02700 ie VERBATIM ; BDB(BREAKM←6) ;
02800 ie WIDEN ; DMARGINS(-1) ; COMMENT SEMI-OBSOLETE ;
02900 END ; COMMENT COMMANDS ;
03000 IF ITSCH(;) THEN PASS ;
03100 RETURN(TRUE) ;
03200 END ;
00100 INTERNAL RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID) ;
00200 BEGIN
00300 IF PAGEMARKS > PAGEWAS THEN
00400 BEGIN comment, might be AT PAGEMARK response ;
00500 FOR PAGEWAS ← PAGEWAS + 1 THRU PAGEMARKS DO IF SIGNALD[FF] THEN RESPOND(SIGNALD[FF]) ;
00600 PAGEWAS ← PAGEMARKS ;
00700 END ;
00800 RETURN(THISISID AND (ASSIGNMENT OR LABELDEF OR COMMAND) OR TEXTLINE OR EMPTYCHUNK OR NONSENSE(VALID)) ;
00900 END "CHUNK" ;
01000
01100 INTERNAL SIMPLE PROCEDURE MANUSCRIPT ;
01200 BEGIN
01300 BOOLEAN VALID ;
01400 VALID ← TRUE ;
01500 DO VALID ← CHUNK(VALID) UNTIL LAST < 1 ;
01600 IF ¬NEXTS(7!MANUSCRIPT) THEN WARN("=","BRACKETS DON'T PAIR UP!!!!!!!!!") ;
01700 FINPORTION ; IF BLNMS=0 THEN BEGINEND ELSE IF BLNMS>0 THEN
01800 WARN("=",CVS(BLNMS) & " EXTRA BEGIN'S AND STARTS") ;
01900 END "MANUSCRIPT" ;
02000
02100 END "INNER BLOCK" ;
02200
02300 END "PARSER"